The notebook reproduces ITS level score and contribution of each feature toward ST score computed using Multiple Instance Learning based approach.
plot_circos <- function(
df,
dkey,
diagnoses,
subtype_colors,
features_selected,
UNI_COLOR = FALSE,
legend_fontsize = 22
){
df <- df[df[[dkey]] %in% diagnoses, ]
df_sub <- df
sample_info <- df_sub[!duplicated(df_sub[[skey]]), ]
sample_info$diag_order <- ifelse(sample_info[[dkey]] == "Normal", 1, 2)
sample_info <- sample_info[order(sample_info$diag_order, sample_info[[skey]]), ]
split <- factor(df_sub[[skey]], levels = sample_info[[skey]])
cell_widths <- rep(1, nrow(df_sub))
# ITS level score from MIL model
mat3 <- df_sub[, "score", drop = FALSE]
# Define color ranges
l_percentile <- 0.01; h_percentile <- 0.99
if (UNI_COLOR){
abs_effects <- abs(df[, features_selected])
breaks2 <- quantile(abs_effects, probs = c(0.5, h_percentile), na.rm = TRUE)
col_fun2 <- colorRamp2(breaks2, c("white", "red"))
mat2 <- abs(df_sub[, features_selected, drop = FALSE])
}else{
breaks2 <- quantile(df[, features_selected], probs = c(l_percentile,0.5,h_percentile), na.rm=TRUE)
col_fun2 <- colorRamp2(breaks2, c("blue","white","red"))
mat2 <- df_sub[, features_selected, drop = FALSE]
}
breaks3 <- quantile(df[, "score"], probs = c(l_percentile,0.5,h_percentile), na.rm=TRUE)
col_fun3 <- colorRamp2(breaks3, c("blue","white","red"))
# --- Circos plotting ---------------------------------------------------------
circos.clear()
circos.par(
start.degree = 90,
gap.degree = 2, # very small gap between samples
track.margin = c(0.005, 0.005),
cell.padding = c(0, 0, 0, 0)
)
# Outer heatmap: Shwoing effect per spatiotype on ST micro score
circos.heatmap(
mat2,
split = split,
col = col_fun2,
cell_width = cell_widths,
track.height = 0.70, # bigger outer heatmap rows
show.sector.labels = FALSE,
bg.border = "black"
)
# Spacer (tiny)
circos.trackPlotRegion(
factors = split,
track.index = 2,
track.height = 0.002,
ylim = c(0, 1),
bg.border = NA
)
# ST micro score per ITS
circos.heatmap(
mat3,
split = split,
col = col_fun3,
cell_width = cell_widths,
track.height = 0.10, # thinner inner ring
bg.border = "black"
)
# Thin diagnosis ring (Normal vs ET, etc)
circos.trackPlotRegion(
factors = split,
track.index = 4,
track.height = 0.04,
ylim = c(0, 1),
bg.border = NA,
panel.fun = function(x,y) {
sector_name <- get.cell.meta.data("sector.index")
diag_val <- sample_info[sample_info[[skey]] == sector_name, dkey]
fill_color <- subtype_colors[as.character(diag_val)]
circos.rect(
xleft = get.cell.meta.data("xlim")[1],
ybottom = 0,
xright = get.cell.meta.data("xlim")[2],
ytop = 1,
col = fill_color,
border = NA
)
}
)
lgd_mat2 <- Legend(
title = "Effect",
col_fun = col_fun2,
title_gp = gpar(fontsize = legend_fontsize, fontface = "bold"),
labels_gp = gpar(fontsize = legend_fontsize)
)
lgd_mat3 <- Legend(
title = "ITS Score",
col_fun = col_fun3,
title_gp = gpar(fontsize = legend_fontsize, fontface = "bold"),
labels_gp = gpar(fontsize = legend_fontsize)
)
feature_legend <- Legend(
labels = features_selected,
title = "Top 12 Features",
ncol = 1,
legend_gp = gpar(fill = "white", col = "black"),
labels_gp = gpar(fontsize = legend_fontsize), # increase label size
title_gp = gpar(fontsize = legend_fontsize, fontface = "bold")
)
legends_combined <- packLegend(lgd_mat2, lgd_mat3, feature_legend)
draw(
legends_combined,
x = unit(1,"npc") - unit(2,"mm"),
y = unit(1,"npc") - unit(2,"mm"),
just = c("right","top")
)
}
library(circlize)
## ========================================
## circlize version 0.4.16
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: https://jokergoo.github.io/circlize_book/book/
##
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
## in R. Bioinformatics 2014.
##
## This message can be suppressed by:
## suppressPackageStartupMessages(library(circlize))
## ========================================
library(ComplexHeatmap)
## Loading required package: grid
## ========================================
## ComplexHeatmap version 2.22.0
## Bioconductor page: http://bioconductor.org/packages/ComplexHeatmap/
## Github page: https://github.com/jokergoo/ComplexHeatmap
## Documentation: http://jokergoo.github.io/ComplexHeatmap-reference
##
## If you use it in published research, please cite either one:
## - Gu, Z. Complex Heatmap Visualization. iMeta 2022.
## - Gu, Z. Complex heatmaps reveal patterns and correlations in multidimensional
## genomic data. Bioinformatics 2016.
##
##
## The new InteractiveComplexHeatmap package can directly export static
## complex heatmaps into an interactive Shiny app with zero effort. Have a try!
##
## This message can be suppressed by:
## suppressPackageStartupMessages(library(ComplexHeatmap))
## ========================================
# Importing data directories
source("../../../configuration.R")
merge_idx <- "index"
skey <- "sample_key"
dkey <- "diagnosis2"
rkey <- "it_regions"
UNI_COLOR = FALSE
statsDf <- read.csv(STConfig$pth_spatiotypes_feat_label)
itr_df <- read.csv(STConfig$pth_its_score_file)
features <- sort(grep("\\.[0-9]+", names(statsDf), value = TRUE))
names(itr_df)[names(itr_df)=='it_id'] <- 'index'
cols_to_drop <- c("fold_idx", "label")
df_subset <- itr_df[, !(names(itr_df) %in% cols_to_drop)]
df_grouped <- aggregate(. ~ index, data = df_subset, FUN = function(x) mean(x, na.rm = TRUE))
statsDf$index <- paste(statsDf$sample_key, '_R', statsDf$it_regions, sep = "")
names(statsDf)[names(statsDf) %in% features] <- paste0("feat_value_", features)
merged_df <- merge(statsDf, df_grouped, by = merge_idx)
# --- Feature selection -------------------------------------------------------
variances <- sapply(merged_df[, features], function(x) if(is.numeric(x)) var(x, na.rm = TRUE) else NA)
variances <- variances[!is.na(variances)]
k <- 12
top_k_indices <- order(variances, decreasing = TRUE)[1:k]
features_selected <- names(variances)[top_k_indices]
subtype_colors <- c(
"Normal" = "green",
"ET" = "blue",
"PV" = "red",
"MF" = "orange",
"PrePMF" = "purple",
"MPN" = "purple"
)
plot_circos(
merged_df,
dkey,
c("Normal","MF"),
subtype_colors,
features_selected,
UNI_COLOR = FALSE,
legend_fontsize = 26
)
plot_circos(
merged_df,
dkey,
c("Normal","ET"),
subtype_colors,
features_selected,
UNI_COLOR = FALSE,
legend_fontsize = 26
)
plot_circos(
merged_df,
dkey,
c("Normal","PV"),
subtype_colors,
features_selected,
UNI_COLOR = FALSE,
legend_fontsize = 26
)